home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / comm / fido / XPACK275.lha / rexx / XQ.REXX < prev    next >
OS/2 REXX Batch file  |  1995-04-17  |  17KB  |  480 lines
  1. /**/
  2. v="$VER: XQ Rexx  Convert FlatFile format to Xferq Williamson 54.27"
  3. /* OPTIONS */
  4. dl="FIDONET 1 FIDONET 2 FIDONET 3 FIDONET 4 FIDONET 5 FIDONET 6 AMIGANET 39 AMIGANET 40 AMIGANET 41 FRANCOMEDIA 101 MTLNET 17 CJNET 100"
  5.  
  6. options results
  7. options failat 99
  8. signal on syntax
  9. signal on halt
  10. signal on ioerr
  11. signal on break_c
  12. signal on break_d
  13.  
  14. if ~show('L',"rexxsupport.library") then
  15.     if ~addlib("rexxsupport.library",0,-30,0) then do
  16.         say "Couldn't access rexxsupport.library !"
  17.         exit 20
  18.     end 
  19. if ~show('L',"rexxdossupport.library") then
  20.     if ~addlib("rexxdossupport.library",0,-30,2) then do
  21.         say "Couldn't access rexxdossupport.library !"
  22.         exit 20
  23.     end 
  24. if ~show("L","xferq.library") then
  25.     if ~addlib("xferq.library",0,-30,0) then do
  26.         say "Couldn't access xferq.library !"
  27.         exit 20
  28.     end
  29.  
  30. OUTDIR=addslash(dequote(GetClip('OUTDIR')))
  31. FLODIR=addslash(dequote(GetClip('FLODIR')))
  32. myaddress.domain=upper(GetCLip("DOMAIN"))
  33. DLIST=upper(GetCLip("DOMAINLIST"))
  34.  
  35. script="XQ";sv=right(v,5)
  36. log=show('p','ROOFLOG')
  37. parse arg args
  38. Quiet=0;CleanOnly=0;Clean=0;NoCVT=0;No4D=0;Xpack=0;Qouts=0;NoDeleteTIC=0;PktCvt=0;Debug=0
  39. template="CleanOnly/S,Clean/S,NoCVT/S,No4D/S,Xpack/S,Qouts/S,NoDeleteTIC/S,PktCvt/S,Quiet/S,Debug/S"
  40. if ~ReadArgs(args,template) then do
  41.     say;say Fault(RC,"  "script' v'sv)
  42.     say template
  43.     say '   CleanOnly   do a cleanup of non-existing files and exit'
  44.     Say '   Clean       do a cleanup of non-existing files'
  45.     Say '   NoCVT       FLO to Queue conversion will not be done'
  46.     Say '   Xpack       Xpack will be called'
  47.     Say '   Qouts       Queue OUT files remaining after XPACK'
  48.     Say '   NoDeleteTIC TIC will not be forced to delete after send'
  49.     Say '   No4D        4d to 5d filename conversion not done'
  50.     Say '   PktCvt      Packet is converted from 4D FTS1 to 5D FSC39'
  51.     Say '   Quiet       No console or log output'
  52.     exit RC
  53. end
  54. if No4D & PktCvt then do
  55.     Say 'Cannot do PktCvt without doing 4D to 5D conversion'
  56.     exit 10
  57. end
  58. IF DLIST~="" & DLIST~="DLIST" THEN dl=DLIST
  59. QDIR=OUTDIR"f"
  60. call makedir(QDIR)
  61. QDIR=addslash(QDIR)
  62. XQ_NOTHING=0;XQ_DELETE=1;XQ_TRUNCATE=2;XQ_IMMEDIATE=4;XQ_SENDLATER=8;XQ_IFSENT=16
  63. DTPRI_CRASH=50;DTPRI_DIRECT=30;DTPRI_NORM=0;DTPRI_HOLD=-50
  64.  
  65. if CleanOnly then do
  66.     call cleanxq
  67.     exit
  68. end
  69. if Clean then call cleanxq
  70. if ~NoCVT then call flocvt
  71. if ~No4D then call out_5d
  72. if xpack then do
  73.     x=pragma("W","NULL")
  74.     if exists("RPDIR:XPACK") then address COMMAND "XPACK"
  75.     else Address "REXX" GetClip('REXXDIR')'/Xpack.rexx'
  76. end
  77. call scanout
  78. exit
  79.  
  80. flocvt:
  81. if ~quiet then call PutLog('Searching for 4D ?LO files in' flodir)
  82. Address COMMAND 'LIST >T:flofile.list 'flodir'#?.#?.#?.#?.?LO quick nohead'
  83. if word(statef("T:flofile.list"),2)=0 then do
  84.    if ~quiet then call PutLog('No 4D ?LO files in' OUTDIR);return 0
  85. end
  86.  
  87. if ~open('flolist',"T:flofile.list",'R') then do
  88.    if ~quiet then call PutLog("Error opening 4D .FLO listing");exit 10
  89. end
  90. i=0
  91. do while ~eof('flolist')
  92.   Line=Upper(strip(space(ReadLn('flolist'),1),'B'))
  93.   if Line="" then iterate
  94.   if debug then call PutLog('FLOLIST:'Line)
  95.   i=i+1
  96.   flofile.i=Line
  97.   parse var Line flonode.i.zone"."flonode.i.net"."flonode.i.node"."flonode.i.point"."junk
  98.   flofileadr.i=find_domain(flonode.i.zone)'#'flonode.i.zone":"flonode.i.net"/"flonode.i.node"."flonode.i.point  
  99.  
  100.   if Left(junk,1)="C" then flofile.i.pri=DTPRI_CRASH
  101.   if Left(junk,1)="H" then flofile.i.pri=DTPRI_HOLD
  102.   if Left(junk,1)="D" then flofile.i.pri=DTPRI_DIRECT
  103.   if Left(junk,1)="N" then flofile.i.pri=DTPRI_NORM
  104.   if Left(junk,1)="F" then flofile.i.pri=DTPRI_NORM
  105.   if debug then call PutLog("FLOLIST:"flofile.i.domain flofileadr" PRI:"flofile.i.pri) 
  106. end
  107. call close('flolist')
  108. if i=0 then do
  109.   if ~quiet then call PutLog("Error: No 4D ?LO Files found in" flodir);return 0
  110. end
  111.  
  112. flofile.numnodes=i
  113. do anode=1 until anode=flofile.numnodes
  114.   drop flags
  115.   if ~quiet then call PutLog("Converting" flofile.anode "for" flofileadr.anode)
  116.   floname=upper(flodir||flofile.anode)
  117.   if debug then call PutLog("FLO FileName:"floname)
  118.   site=flofileadr.anode
  119.  
  120.   cfgaddress=GetClip('HOST.ADDRESS.'myaddress.domain)
  121.   parse var cfgaddress myaddress.zone ":" myaddress.net "/" myaddress.node "." myaddress.point
  122.  
  123.   site_address=XfqGetAddress(site)
  124.   err=0
  125.   if ~exists(floname) then do
  126.       if ~quiet then call PutLog("Error: Can't find "floname)
  127.       call drop_vars
  128.       err=1
  129.   end;else if ~Open('flofile',floname,'R') then do
  130.       if ~quiet then call PutLog("Error: Can't open" floname)
  131.       call drop_vars
  132.       err=1
  133.   end
  134.  
  135.   if ~err then do
  136.       do while ~eof('flofile')
  137.           Line=upper(ReadLn('flofile'))
  138.           if Line="" then Iterate
  139.           flags=XQ_NOTHING
  140.           if (LEFT(Line,1)="#") then do
  141.               flags=XQ_TRUNCATE
  142.               Line=DELSTR(Line,1,1)
  143.           end;else if (LEFT(Line,1)="^")|(LEFT(Line,1)="-") then do
  144.               flags=XQ_DELETE
  145.               Line=DELSTR(Line,1,1)
  146.           end;else if (LEFT(Line,1)="@") then do
  147.               flags=XQ_NOTHING
  148.               Line=DELSTR(Line,1,1)
  149.           end
  150.           if ~exists(Line) then do
  151.               if ~quiet then call PutLog("File "Line" No Longer Exists");Iterate
  152.           end
  153.           if right(Line,2)="UT" then do
  154.               sendas=get_packetname()
  155.               select
  156.               when Left(right(Line,3),1)="C" then t.pri=DTPRI_CRASH
  157.               when Left(right(Line,3),1)="H" then t.pri=DTPRI_HOLD
  158.               when Left(right(Line,3),1)="D" then t.pri=DTPRI_DIRECT
  159.               when Left(right(Line,3),1)="N" then t.pri=DTPRI_NORM
  160.               otherwise do
  161.                 if ~quiet then Call PutLog('Skipping Unknown OUT file flavour:'Line);Iterate
  162.               end;end
  163.               if ~quiet then call PutLog('Moving 'Line' to 'QDIR)
  164.               call rename(Line,QDIR||Get_fn(Line))
  165.               Line=QDIR||get_fn(Line)
  166.            end;else do
  167.                parse var Line x '.' x '.' x '.' x '.' ext
  168.                if ext="" then do
  169.                   sendas=get_fn(Line)
  170.                   if ~nodeletetic & right(Line,3)="TIC" then flags=XQ_DELETE
  171.                   else flags=XQ_NOTHING
  172.                   t.pri=flofile.anode.pri
  173.               end;else do
  174.                   tmpext=upper(left(ext,2))
  175.                   if datatype(right(ext,1),'n') & (tmpext="MO"|tmpext="TU"|tmpext="WE"|tmpext="TH"|tmpext="FR"|tmpext="SA"|tmpext="SU") then do
  176.                       sendas=UPPER(d2x(65536+myaddress.net-flonode.anode.net,4)||d2x(65536+   myaddress.node-flonode.anode.node,4)'.'ext)
  177.                       flags=XQ_DELETE
  178.                       t.pri=flofile.anode.pri
  179.                   end
  180.               end
  181.               drop ext x
  182.           end
  183.           if ~quiet then call PutLog('Queueing:'Line' as 'sendas' for:'site' Disp:'flags' Pri:'t.pri)
  184.           QUERY.XQ_NAME=Line
  185.           QUERY.XQ_SITE=site_address
  186.           work=NULL
  187.           work=XfqFindWork(QUERY)
  188.           if work=NULL then do
  189.               if ~quiet then call PutLog("File "line" not in site queue, adding as "sendas)
  190.               XfqAddWorkQuick(site,Line,sendas,t.pri,flags)
  191.           end;else do
  192.             if ~quiet then call PutLog("File "line" found, re-queueing")
  193.             call XfqUnlockWork(work)
  194.           end
  195.       end
  196.       call close('flofile')
  197.       call delete(floname)
  198.   end
  199.   call XfqFlushQueue(site_address)
  200.   call XfqDropObject(site_address)
  201.   if work ~=NULL then call XfqDropObject(work)
  202. end
  203. call XfqClose()
  204. call drop_vars
  205. call delete("T:flofile.list")
  206. return
  207.  
  208. out_5d:
  209. if ~quiet then call PutLog('Searching for 4D OUT files in 'OUTDIR)
  210. address COMMAND 'List >T:out.temp' OUTDIR'#?.#?.#?.#?.?UT LFORMAT "%N"'
  211. if debug then address command 'type T:out.temp'
  212. if ~exists('T:out.temp')|word(statef('T:out.temp'),2) < 2|~open('olist','T:OUT.TEMP','r') then do
  213.     if ~quiet then call PutLog('No 4D ?UT files to convert');return 0
  214. end
  215. do while ~eof('olist')
  216.     outfile=readln('olist')
  217.     if outfile="" then iterate
  218.     if debug then call PutLog('OUTFILE:'outfile)
  219.     parse var outfile z '.' n '.' f '.' p '.' type junk
  220.     if datatype(z,'MIXED')|junk ~="" then do
  221.        if ~quiet then call putlog(outfile' not 4D')
  222.        if datatype(z,'MIXED') & ~quiet then call PutLog(outfile' pending for 'z)
  223.        Iterate
  224.     end
  225.     if PktCvt then call pcvt(OUTDIR||outfile)
  226.     else do
  227.         if debug then call PutLog('Renaming:' OUTDIR||outfile 'to' OUTDIR||find_domain(z)'.'z'.'n'.'f'.'p'.'type)
  228.         call rename(OUTDIR||outfile,OUTDIR||find_domain(z)'.'z'.'n'.'f'.'p'.'type)
  229.     end
  230.  
  231. end
  232. call close('olist')
  233. call delete('T:out.temp')
  234. return
  235.  
  236.  
  237. scanout:
  238. if ~quiet then call PutLog('Searching for 5D .?UT files in' OUTDIR)
  239. Address COMMAND 'LIST >T:outfile.list 'OUTDIR'#?.#?.#?.#?.#?.?UT quick nohead'
  240. if word(statef("T:outfile.list"),2)=0 then do
  241.    if ~quiet then call PutLog('No 5D ?UT files in' OUTDIR);return 0
  242. end
  243. if ~open('outs',"T:outfile.list",'R') then do
  244.    if ~quiet then call PutLog("Error opening 5D .?UT list");exit 10
  245. end
  246. do while ~eof('outs')
  247.    outfile=upper(readln('outs'))
  248.    if outfile="" then iterate
  249.    parse var outfile ogd '.' ogz '.' ogn '.' ogf '.' ogp '.' ext
  250.    if ~Qouts & ext="OUT" then do
  251.        if ~quiet then call PutLog('Skipping 'outfile);Iterate
  252.    end
  253.    xtype=left(ext,1)
  254.    if xtype="C" then flonode.i.pri=DTPRI_CRASH
  255.    else if xtype="H" then flonode.i.pri=DTPRI_HOLD
  256.    else if xtype="D" then flonode.i.pri=DTPRI_DIRECT
  257.    else if xtype="N" then flonode.i.pri=DTPRI_NORM
  258.    else if xtype="O" then flonode.i.pri=DTPRI_NORM
  259.    else do
  260.        if ~quiet then call PutLog('ERROR: cannot queue 'outfile);Iterate
  261.    end
  262.        if ~quiet then call PutLog('Moving 'OUTDIR||outfile' to 'QDIR)
  263.        newfullname=QDIR||Get_fn(OUTDIR||outfile)
  264.        call rename(OUTDIR||outfile,newfullname)
  265.        call addwork(ogd'#'ogz':'ogn'/'ogf'.'ogp,newfullname "D" flonode.i.pri)
  266. end  
  267. call close('outs')
  268. call delete("T:outfile.list")
  269. return
  270.  
  271. addwork:
  272. site_address=arg(1)
  273. qaz=space(arg(2),1)
  274. parse var qaz file disposition priority
  275. if ~quiet then call PutLog('Addwork:'site_address file disposition priority)
  276. parse var site_address td '#' tz ':' tn '/' tf '.' tp
  277. if file=""|~(exists(file)) then do
  278.    if ~quiet then call PutLog('Cannot find ['file']'); return 1
  279. end
  280. file=upper(file)
  281. select
  282.    when disposition="D" then flags=XQ_DELETE
  283.    when disposition="T" then flags=XQ_TRUNCATE
  284.    when disposition="L" then flags=XQ_NOTHING
  285.    otherwise flags=XQ_NOTHING
  286. end
  287. select
  288.    when priority>30 then priority=DTPRI_CRASH
  289.    when priority>0 then priority=DTPRI_DIRECT
  290.    when priority=0 then priority=DTPRI_NORM
  291.    when priority=-50 then priority=DTPRI_HOLD
  292.    otherwise priority=DTPRI_CRASH
  293. end
  294. if right(file,4)=".CUT"|right(file,4)=".DUT"|right(file,4)=".HUT"|right(file,4)=".OUT" then do
  295.    sendas=get_packetname()
  296.    flags=XQ_DELETE
  297. end;else do
  298.    if ~quiet then call PutLog(file 'not processed');return 0
  299. end
  300.  
  301. site=td"#"tz":"tn"/"tf"."tp
  302. cfgaddress=GetClip('HOST.ADDRESS.'myaddress.domain)
  303. parse var cfgaddress myaddress.zone ":" myaddress.net "/" myaddress.node "." myaddress.point
  304. site_address=XfqGetAddress(site)
  305. QUERY.XQ_NAME=file
  306. QUERY.XQ_SITE=site_address
  307. work=NULL
  308. work=XfqFindWork(QUERY)
  309. if work=NULL then do
  310.     if ~quiet then call PutLog("File "file" not in site queue, adding")
  311.     XfqAddWorkQuick(site,file,sendas,priority,flags)
  312. end;else do
  313.     if ~quiet then call PutLog("File "file" already queued")
  314.     call XfqUnlockWork(work)
  315. end
  316. call XfqFlushQueue(site_address)
  317. call XfqDropObject(site_address)
  318.   if work ~=NULL then call XfqDropObject(work)
  319. call XfqClose()
  320. return
  321.  
  322. cleanxq:
  323.     sitelist=XfqGetSiteList()
  324.     call XfqWalkSession(sitelist,sitearray)
  325.     if ~quiet then call PutLog("There are "sitearray.numentries" sites in the queue")
  326.     do loop=1 to sitearray.numentries
  327.         addrtags.XQ_Mandatory=511;addrtags.XQ_Optional=511
  328.         System=XfqPutAddress(sitearray.loop,addrtags)
  329.         call XfqWalkQueue(sitearray.loop,thestem)
  330.         if ~quiet then call PutLog("There are "thestem.NUMENTRIES" files for "System)
  331.         do i=1 to thestem.NUMENTRIES
  332.             if ~quiet then call PutLog("Sending "thestem.i.NAME" as "thestem.i.ASNAME" at priority "thestem.i.PRI) 
  333.             if ~EXISTS(thestem.i.NAME) then do
  334.                 if ~quiet then call PutLog("File "thestem.i.NAME" does not exist")
  335.                 FINDIT.XQ_NAME=thestem.i.NAME
  336.                 FINDIT.XQ_SITE=sitearray.loop
  337.                 work=XfqFindWork(FINDIT)
  338.                 if(work~=NULL) then call XfqRemoveWork(work)
  339.             end
  340.         end
  341.     end
  342.     call XfqDropObject(sitelist)
  343.     call XfqClose()
  344. return thestem.NUMENTRIES
  345.  
  346. get_packetname:
  347. if ~open('out',"CFG:packet_spec",'R') then call PutLog("Can't read packet_spec file")
  348. else do
  349.    packet_spec=readln('out')
  350.    close('out')
  351. end
  352. tspec=left(date(),2)||compress(time(),":")
  353. if (tspec=packet_spec) then tspec=tspec+1
  354. do while exists(OUTDIR||tspec".PKT")
  355.    tspec=tspec+1
  356. end
  357. if ~open('out',pktspec,'W') then call PutLog("Can't write new packet_spec file")
  358. else do
  359.    writeln('out',tspec)
  360.    close('out')
  361. end
  362. return(tspec".PKT")
  363.  
  364. get_fn: procedure
  365. if LastPos('/',arg(1)) ~=0 then return SubStr(arg(1),LastPos('/',arg(1)) + 1)
  366. else if LastPos(':',arg(1)) ~=0 then return SubStr(arg(1),LastPos(':',arg(1)) + 1)
  367. else return arg(1)
  368.  
  369. find_domain: procedure expose dl
  370. dz=FIND(dl,arg(1))
  371. if dz=0 then return GetClip('DOMAIN')
  372. else return strip(word(dl,dz-1))
  373.  
  374. drop_vars:
  375. drop tonode. flonode. hisaddress. work err line
  376. drop flofileadr site site_address i file pktname floname sendas flags disposition priority
  377. return 0
  378.  
  379. PutLog: procedure expose log script
  380. if log then address 'ROOFLOG' 'logline' left(time(),5) script': 'arg(1)
  381. else say arg(1)
  382. return 0
  383.  
  384. addslash:
  385. curr=arg(1)
  386. select
  387. when right(curr,1)=":" then nop
  388. when right(curr,1)="/" then nop
  389. otherwise curr=curr"/"
  390. end
  391. return curr
  392.  
  393. dequote: procedure
  394. parse arg thing
  395. parse var thing '"' unq_thing '"'
  396. if unq_thing ~="" then return unq_thing
  397. return thing
  398.  
  399. break_c:
  400. break_d:
  401. call cleanup()
  402. if ~quiet then call PutLog('User Aborted')
  403. exit 0
  404. novalue:
  405. call template_oops "Novalue" sigl
  406. syntax:
  407. call template_oops "Syntax(RC="RC")" sigl RC
  408. failure:
  409. call template_oops "Failure(RC="RC")" sigl
  410. ioerr:
  411. call template_oops "IOErr(RC="RC")" sigl
  412. halt:
  413. call template_oops "Halt" sigl
  414. template_oops:
  415. parse arg what badline code
  416. if code~="" then call PutLog("ERROR LINE:"badline errortext(code))
  417. else call PutLog("ERROR LINE:"badline what)
  418. cleanup:
  419. call XfqClose()
  420. if ~debug then do
  421. call delete('T:flofile.list')
  422. call delete('T:outfile.list')
  423. call delete('T:out.temp')
  424. end
  425. exit(40)
  426.  
  427.  
  428. pcvt:
  429. packet=arg(1)
  430. /* Convert packets from FTS1 to FSC-0039 and renames to 5D */
  431. prodmaj="DA"x;prodmin="00"x;proddata="XQ39";revmaj=d2c(substr(sv,1,2));revmin=d2c(substr(sv,4,2))
  432. cw=reverse(right("00"x||"01"x,2));cv=reverse(right("01"x||"00"x,2)) 
  433. pointnet=GetClip('POINTNET');domain=find_domain(z)
  434. cfgaddress=GetClip('HOST.ADDRESS.'domain)
  435. parse var cfgaddress myzone ":" mynet "/" mynode "." mypoint
  436.  
  437. if ~exists(packet) then do
  438.     if ~quiet then call PutLog(packet' Not Found')
  439.     return
  440. end;else do
  441.     remap=n==pointnet
  442.     if remap then newpacket=OUTDIR||domain'.'myzone'.'mynet'.'mynode'.'f'.'type
  443.         else newpacket=OUTDIR||domain'.'myzone'.'n'.'f'.'p'.'type
  444.     if ~quiet then call PutLog('Copying 'packet 'to' newpacket)
  445.     address COMMAND 'Copy' packet newpacket
  446.     if ~open('pkt',newpacket,'R') then do
  447.         if ~quiet then call PutLog("Can't open "newpacket)     
  448.         return
  449.     end
  450.     if ~quiet then call PutLog('Converting 'domain newpacket' to FSC-0039, Zone:'myzone)
  451.     buffer=readch('pkt',60)
  452.     ozone=reverse(right("00"x||d2c(myzone),2))
  453.     dzone=reverse(right("00"x||d2c(myzone),2))
  454.     if remap then do
  455.         dnet=reverse(right("00"x||d2c(mynet),2))
  456.         dnode=reverse(right("00"x||d2c(mynode),2))
  457.         dpoint=reverse(right("00"x||d2c(f),2))
  458.         buffer=overlay(dnode,buffer,3)
  459.         buffer=overlay(dnet,buffer,23)
  460.         buffer=overlay(dpoint,buffer,53)
  461.     end
  462.     buffer=overlay(prodmaj||revmaj,buffer,25)
  463.     buffer=overlay(ozone||dzone,buffer,35)
  464.     buffer=overlay(cv,buffer,41)
  465.     buffer=overlay(prodmin||revmin,buffer,43)
  466.     buffer=overlay(cw,buffer,45)
  467.     buffer=overlay(ozone||dzone,buffer,47)
  468.     buffer=overlay(proddata,buffer,55)
  469.     if ~quiet then call PutLog('Writing FSC-0039:'newpacket,60,10)
  470.     call seek('pkt',0,"B")      /* go to start of file */
  471.     call writech('pkt',buffer) 
  472.     call close('pkt')
  473.  
  474.     if debug then call PutLog('Deleting FTS-0001:'packet)   
  475.     call delete(packet)
  476.     drop buffer packet newpacket
  477. end
  478. return
  479.  
  480.